﻿Option Explicit On
'*******************************************************************
' Program: pkgVisio
' Author: Albert E Edlund
' Date:
'
' Purpose:
' Working with office object XML
'
' dim pic as Ipicture = directcase(app.activedocument.masters.icon, IPicture)
' dim img as Image = Icon.FromHandle(DirectCast(pic.handle, intPtr)).toBitmap()
'
'
'
' 
'*******************************************************************


#Region " imports "

Imports System
Imports System.Object
Imports System.IO
Imports System.IO.TextReader
' need to reference windowsbase in .net
Imports System.IO.Packaging

' need for dbconnectionstringbuilder used in clsConnections
Imports System.Data.Common

Imports System.Windows
Imports System.Windows.Forms
Imports System.Text.StringBuilder

Imports Microsoft.VisualBasic

Imports System.Text
Imports System.Collections
Imports System.Collections.Generic
Imports System.Collections.ObjectModel

Imports System.Xml
Imports System.Linq
Imports System.Linq.Enumerable
Imports System.Windows.Input

Imports System.Xml.Serialization
Imports System.Xml.Linq
Imports System.Xml.XPath

Imports ADODB
Imports System.Data
Imports System.Data.OleDb
Imports System.Data.Sql


Imports Microsoft.Practices.EnterpriseLibrary.Common
Imports Microsoft.Practices.EnterpriseLibrary.ExceptionHandling
Imports Microsoft.Practices.EnterpriseLibrary.ExceptionHandling.Logging


' visio v15 does not use a xName prefix which may put it into conflict with other open office apps
Imports <xmlns="http://schemas.microsoft.com/office/visio/2012/main">
Imports <xmlns:rs="urn:schemas-microsoft-com:rowset">

' generic namespace for office open xml, used in all of them
Imports <xmlns:r="http://schemas.openxmlformats.org/officeDocument/2006/relationships">

Imports pkgVisio.clsVisPackage
Imports pkgVisio.clsStructures


#End Region



'**********************************************************************************
'
'**********************************************************************************
'
Public Class clsMaster


#Region " properties and declarations "

    '
    ' a local copy of the clsVisPackage
    '
    Public m_visPackage As clsVisPackage
    Public Property visPackage As clsVisPackage
        Get
            visPackage = Me.m_visPackage
        End Get
        Set(value As clsVisPackage)
            If (value Is Nothing) Then
                Throw New System.ArgumentNullException("Value", _
                    "visPackage is Null.")
            End If
            Me.m_visPackage = value
        End Set
    End Property


    '
    '
    '
    Public _xDoc As XDocument
    Public Property xDoc As XDocument
        Get
            Return Me._xDoc
        End Get
        Set(value As XDocument)
            If (value Is Nothing) Then
                Throw New System.ArgumentNullException("Value", _
                    "xDoc is Null.")
            End If
            Me._xDoc = value
        End Set
    End Property

    '
    '
    '
    Public _newXdoc As XDocument
    Public Property newXdoc As XDocument
        Get
            newXdoc = Me._newXdoc
        End Get
        Set(value As XDocument)
            Me._newXdoc = value
        End Set
    End Property

    '
    '
    '
    Public _strMasterFile As String
    Public Property strMasterFile As String
        Get
            strMasterFile = Me._strMasterFile
        End Get
        Set(value As String)
            Me._strMasterFile = value
        End Set
    End Property

    '
    '
    '
    Public _xelemMasterShapes As XElement
    Public Property xelemMasterShapes As XElement
        Get
            xelemMasterShapes = Me._xelemMasterShapes
        End Get
        Set(value As XElement)
            Me._xelemMasterShapes = value
        End Set
    End Property


    '
    '
    '
    Public _intMasterShapeCount As Integer
    Public ReadOnly Property intMasterShapeCt As Integer
        Get
            If Me.xDoc Is Nothing Then
                intmasterShapeCt = 0
            Else
                Dim qryMasterShapes = Me.xDoc...<Shape>
                intmasterShapeCt = qryMasterShapes.Count
            End If
        End Get
    End Property

    '
    '
    '
    Public _lngNewRootShapeId As Long
    Public Property lngNewRootShapeId As Long
        Get
            lngNewRootShapeId = Me._lngNewRootShapeId
        End Get
        Set(value As Long)
            Me._lngNewRootShapeId = value
        End Set
    End Property


    Private _lngCurrShapeId As Long
    Public Property lngCurrShapeId As Long
        Get
            lngCurrShapeId = Me._lngCurrShapeId
        End Get
        Set(value As Long)
            Me._lngCurrShapeId = value
        End Set
    End Property


    '
    '
    '
    Public _int
#End Region

#Region " Test Strings "


    Public Const MasterTemplateXml As String = _
        "<Master ID=""2"" UniqueID=""{0020640D-0002-0000-8E40-00608CF305B2}"" " _
        & "BaseID=""{8FEBAF3E-100E-46A7-AFB4-6F1C4D75A7A7}"" PatternFlags=""0"" " _
        & "xmlns=""http://schemas.microsoft.com/office/visio/2012/main"">" _
        & "<PageSheet LineStyle=""0"" FillStyle=""0"" TextStyle=""0""> " _
        & "<Cell N=""PageWidth"" V=""2""/> " _
        & "<Cell N=""PageHeight"" V=""1""/> " _
        & "<Cell N=""PageScale"" V=""1""/> " _
        & "<Cell N=""DrawingScale"" V=""1""/> " _
        & "</PageSheet> " _
        & "<Rel r:id=""rId1"" xmlns:r=""http://schemas.openxmlformats.org/officeDocument/2006/relationships"" />" _
        & "</Master>"



#End Region


    '
    ' pass in a "master?.xml" file and load it into the xDoc
    ' this is the shape data for the master
    '
    Public Sub loadMasterShapeXDoc(ByVal strMstrFile As String)

        Try

            Me._xDoc = Nothing
            Me._strMasterFile = strMasterFile

            ' make sure we have the pkgpartInfo
            If Me.visPackage.colPkgPartInfo.Count > 0 Then
                For Each node As pkgpartInfo In Me.visPackage.colPkgPartInfo
                    If node.pkgpartContentType = clsVisPackage.contXmlMaster _
                        And node.pkgpartParent = "/visio/masters/masters.xml" _
                        And node.pkgpartPath = strMstrFile Then
                        ''build the xdoc for the shape
                        Me._xDoc = New XDocument
                        Me.xDoc = Me.visPackage.getPackagePartAsXDoc(Me.visPackage.fileCurrent, node)
                        Exit For
                    End If ' test for correct node
                Next node
            End If ' test for current node collection having objects

        Catch errXml As XmlException
            Me._strMasterFile = ""
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(errXml, "Log Only Policy")
            If (rethrow) Then
                Throw
            End If
        Catch err As Exception
            Me._strMasterFile = ""
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(err, "Log Only Policy")
            If (rethrow) Then
                Throw
            End If
        End Try
    End Sub


    '
    ' add a master contents file and a relationship from the masters to master content
    '
    Public Sub addMasterToMastersPkgParts _
        (ByRef package As Package, _
         ByRef pkgpartMasters As PackagePart, _
         ByVal strMasterPath As String, _
         ByVal strNewRid As String, _
         Optional ByVal strMasterContent As String = clsPage.pageHeaderXML)

        Try
            Const bufSize As Integer = &H1000
            Dim uniEncoding As New UTF8Encoding
            Dim byteXML As Byte()

            ' Relative path and filename of the app file to add to the package.
            Dim masterPath As String = "/visio/masters/" & strMasterPath
            Dim partUriMaster As Uri = PackUriHelper.CreatePartUri(New Uri(masterPath, UriKind.Relative))
            Dim packagePartMaster As PackagePart = package.CreatePart(partUriMaster, clsVisPackage.contXmlMaster)


            ' load the byte array
            byteXML = uniEncoding.GetBytes(strMasterContent)
            Using memStream As New MemoryStream(bufSize)
                memStream.Write(byteXML, 0, byteXML.Length)
                Me.visPackage.CopyStream(memStream, packagePartMaster.GetStream())
            End Using ' close the memory stream
            pkgpartMasters.CreateRelationship(packagePartMaster.Uri, TargetMode.Internal, clsVisPackage.relRidMaster, strNewRid)

            GC.Collect()


        Catch xml As XmlException
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(xml, "Log Only Policy")
            If (rethrow) Then
                Throw
            End If
        Catch err As Exception
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(err, "Log Only Policy")
            If (rethrow) Then
                Throw
            End If
        End Try



    End Sub


    '
    ' add a master contents file and a relationship from the masters to the page
    '
    Public Sub addMasterToPagePkgParts _
        (ByRef packagePartPage As PackagePart)

        Try

            Dim strMstrFile As String = strMasterFile
            Dim strUriPath As String = "../masters/"
            Dim strMstrPath As String = "/visio/masters/"
            strMstrFile = strMasterFile.Replace(strMstrPath, strUriPath)
            Dim myUri As New Uri(strMstrFile, UriKind.RelativeOrAbsolute)
            Try
                ' wrap it in a try..catch so that if it fails we do not quit
                packagepartPage.CreateRelationship(myUri, TargetMode.Internal, clsVisPackage.relRidMaster)
            Catch
            End Try

        Catch xml As XmlException
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(xml, "Log Only Policy")
            If (rethrow) Then
                Throw
            End If
        Catch err As Exception
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(err, "Log Only Policy")
            If (rethrow) Then
                Throw
            End If
        End Try



    End Sub


    '
    ' read the xdoc and get the master contents shapes
    '
    Public Sub loadXelemMasterShapes()

        Try

            ' get the shape data from the file
            Dim qryMasterContents = Me.xDoc...<MasterContents>
            Dim listOfMasterElements As IEnumerable(Of XElement) = _
                    From elem In qryMasterContents.Elements() _
                    Select elem
            For Each elem As XElement In listOfMasterElements
                Dim strElemName As String = LCase(elem.Name.LocalName)
                If strElemName = "shapes" Then
                    xelemMasterShapes = Nothing
                    xelemMasterShapes = elem
                End If
            Next elem

        Catch xml As XmlException
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(xml, "Log Only Policy")
            If (rethrow) Then
                Throw
            End If
        Catch err As Exception
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(err, "Log Only Policy")
            If (rethrow) Then
                Throw
            End If
        End Try

    End Sub


    '
    ' pass in a "shapes" xelement and update the shape.ids so that we
    ' do not end up with duplicate shape.ids on the page when we drop
    ' the master contents
    '
    Public Sub updateXelemMasterShapeIds _
        (ByRef lclXelemMasterShapes As XElement, _
         ByVal lngShapeId As Long, _
         ByVal strSource As String)

        Try


            Dim strElemName As String = ""
            Dim strChildName As String = ""
            Dim intX As Integer = -1

            Dim qrylclMasterRootShape = lclXelemMasterShapes...<Shape>
            Dim intShapeCt As Integer = qrylclMasterRootShape.Count

            Dim elemChild As XElement = Nothing

            For intX = 0 To intShapeCt - 1
                Dim strMasterShpId As String = "-1"
                Dim strShpId As String = "-1"
                elemChild = qrylclMasterRootShape.ElementAt(intX)
                If intX = 0 Then
                    ' apply the new "root" shape.id to the root/master parent shape
                    elemChild.@ID = CStr(lngShapeId)
                End If
                If 0 < intX Then
                    Dim strType As String = elemChild.@Type
                    ' get the shape.id of the subshape
                    strShpId = elemChild.@ID
                    ' apply it to the mastershape attribute (it get's created auto-magically)
                    elemChild.@MasterShape = strShpId
                    ' apply the new shape.id to the subshape
                    elemChild.@ID = CStr(lngShapeId + intX)
                    ' since we point at the master shape removing the sub-elments forces inheritance
                    ' start the element drilldown
                    Dim listOfElements As IEnumerable(Of XElement) = _
                            From elem In elemChild.Elements() _
                            Select elem
                    If listOfElements IsNot Nothing Then
                        Dim intY As Integer = -1
                        For intY = listOfElements.Count - 1 To 0 Step -1
                            Dim elemSub As XElement = listOfElements(intY)
                            Dim strXelemName As String = ""
                            strXelemName = LCase(elemSub.Name.LocalName.ToString)
                            If strXelemName <> "shapes" Then
                                elemSub.Remove()
                            End If
                        Next intY
                    End If

                End If ' test for intx count

                lngCurrShapeId = lngShapeId + intX
                ' Debug.Print("shape " & strShpId & " " & lngCurrShapeId)
            Next intX




        Catch xml As XmlException
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(xml, "Log Only Policy")
            If (rethrow) Then
                Throw
            End If
        Catch err As Exception
            Dim rethrow As Boolean = ExceptionPolicy.HandleException(err, "Log Only Policy")
            If (rethrow) Then
                Throw
            End If
        End Try

    End Sub



    '
    '
    '
    Public Sub New()



        Me._xDoc = Nothing
        Me.xDoc = New XDocument

        Me.m_visPackage = Nothing
        Me.m_visPackage = New clsVisPackage


    End Sub

End Class

